Unit mnWinCECommStreams;
{**
 *  This file is part of the "Mini Comm"
 *
 * @license   modifiedLGPL (modified of http://www.gnu.org/licenses/lgpl.html)
 *            See the file COPYING.MLGPL, included in this distribution,
 * @author    Zaher Dirkey <zaher at parmaja dot com>
 * Some function ported from ComPort at sourceforge thanks for them
 *}

  {$M+}
  {$H+}
  {$IFDEF FPC}
  {$mode delphi}
  {$ENDIF}

Interface

Uses
    Windows,
    Classes, SysUtils,
    mnCommClasses;

Type
    { TmnOSCommStream }

    TmnOSCommStream = Class(TmnCustomCommStream)
    private
        FHandle: THandle;
        FCancelEvent: THandle;
    protected
        Procedure DoConnect; override;
        Procedure DoDisconnect; override;
        Function GetConnected: Boolean; override;
        Function DoWrite(Const Buffer; Count: Integer): Integer; override;
        Function DoRead(Var Buffer; Count: Integer): Integer; override;
        Function GetFlowControlFlags: TFlowControlFlags; override;
    public
        Function WaitEvent(Const Events: TComEvents): TComEvents; override;
        Function GetInQue: Integer; override;
        Procedure Flush; override;
        Procedure Purge; override;
        Procedure Reset; override;
        Procedure Cancel; override;
    End;

Implementation

Uses
    mnWinCommTypes;

Procedure TmnOSCommStream.Cancel;
Begin
    Inherited;
    If FCancelEvent <> 0 Then
    Begin
        SetEvent(FCancelEvent);
        Sleep(0);
    End;
End;

Procedure TmnOSCommStream.DoConnect;
Var
    f: THandle;
    DCB: TDCB;
    aTimeouts: TCommTimeouts;
    P: Pointer;
    aMode: Cardinal;
Begin
    {$ifdef WINCE}
    If RightStr(Port, 1) <> ':' Then P := PWideChar(UTF8Decode((Port + ':')))
    Else P := PWideChar(UTF8Decode(Port));
    {$else}
    P := PChar('\\.\' + Port);
    {$endif}

    aMode := 0;
    Case ConnectMode Of
        ccmReadWrite: 
            aMode := GENERIC_READ or GENERIC_WRITE;
        ccmRead: 
            aMode := GENERIC_READ;
        ccmWrite: 
            aMode := GENERIC_WRITE;
    End;

    f := CreateFile(P, aMode, FILE_SHARE_READ or FILE_SHARE_WRITE,
        Nil, OPEN_EXISTING, 0, 0);
    //  cWriteThrough[WriteThrough]

    If (f = INVALID_HANDLE_VALUE) Then
    Begin
        RaiseLastOSError;
    End;

    FHandle := f;
    Try
{    if not SetupComm(FHandle, BufferSize, BufferSize) then //some devices may not support this API.
    begin
      RaiseLastOSError;
    end;}

        FillChar(DCB, SizeOf(DCB), #0);

        DCB.DCBlength := SizeOf(TDCB);
        DCB.XonLim    := BufferSize div 4;
        DCB.XoffLim   := DCB.XonLim;
        DCB.EvtChar   := EventChar;

        DCB.Flags := dcb_Binary;
        If DiscardNull Then DCB.Flags := DCB.Flags or dcb_Null;

        With GetFlowControlFlags Do
        Begin
            DCB.XonChar := XonChar;
            DCB.XoffChar := XoffChar;
            If OutCTSFlow Then DCB.Flags := DCB.Flags or dcb_OutxCTSFlow;
            If OutDSRFlow Then DCB.Flags := DCB.Flags or dcb_OutxDSRFlow;
            DCB.Flags := DCB.Flags or CControlDTR[ControlDTR] or
                CControlRTS[ControlRTS];
            If XonXoffOut Then DCB.Flags := DCB.Flags or dcb_OutX;
            If XonXoffIn Then DCB.Flags := DCB.Flags or dcb_InX;
            If DSRSensitivity Then DCB.Flags := DCB.Flags or dcb_DSRSensivity;
            If TxContinueOnXoff Then DCB.Flags := DCB.Flags or dcb_TxContinueOnXoff;
        End;

        DCB.Parity   := CParityBits[Parity];
        DCB.StopBits := CStopBits[StopBits];
        DCB.BaudRate := BaudRate;
        DCB.ByteSize := cDataBits[DataBits];

        With GetParityFlags Do 
        If Check Then
        Begin
            DCB.Flags := DCB.Flags or dcb_Parity;
            If Replace Then
            Begin
                DCB.Flags := DCB.Flags or dcb_ErrorChar;
                DCB.ErrorChar := AnsiChar(ReplaceChar);
            End;
        End;

        // apply settings
        If not SetCommState(FHandle, DCB) Then
        Begin
            Raise EComPort.Create('Error in SetCommState ' + IntToStr(GetLastError));
            //      RaiseLastOSError;
        End;

        aTimeouts.ReadIntervalTimeout         := MAXWORD;
        aTimeouts.ReadTotalTimeoutMultiplier  := ReadTimeout;
        aTimeouts.ReadTotalTimeoutConstant    := ReadTimeoutConst;
        aTimeouts.WriteTotalTimeoutMultiplier := WriteTimeout;
        aTimeouts.WriteTotalTimeoutConstant   := WriteTimeoutConst;

        If not SetCommTimeouts(FHandle, aTimeouts) Then
        Begin
            Raise EComPort.Create('Error in SetCommTimeouts' + IntToStr(GetLastError));
            //      RaiseLastOSError;
        End;

    Except
        If FHandle <> 0 Then CloseHandle(FHandle);
        FHandle := 0;
        Raise;
    End;
End;

Procedure TmnOSCommStream.DoDisconnect;
Begin
    If FHandle <> 0 Then Try
            FileClose(FHandle);
        Finally
            FHandle := 0;
        End;
    If FCancelEvent <> 0 Then
    Begin
        CloseHandle(FCancelEvent);
        FCancelEvent := 0;
    End;
End;

Procedure TmnOSCommStream.Flush;
Begin
    Inherited;
    If not Flushfilebuffers(FHandle) Then RaiseLastOSError;
End;

Function TmnOSCommStream.GetConnected: Boolean;
Begin
    Result := FHandle <> 0;
End;

Function TmnOSCommStream.GetInQue: Integer;
Var
    Errors: DWORD;
    ComStat: TComStat;
Begin
    If not ClearCommError(FHandle, Errors, @ComStat) Then
    Raise EComPort.Create('Clear Com Failed');
    Result := ComStat.cbInQue;
End;

Procedure TmnOSCommStream.Purge;
Var
    F: Integer;
Begin
    Inherited;
    F := PURGE_TXCLEAR or PURGE_TXABORT or PURGE_RXABORT or PURGE_RXCLEAR;
    If not PurgeComm(FHandle, F) Then RaiseLastOSError;
End;


Procedure TmnOSCommStream.Reset;
Begin
    Inherited;
End;

Function TmnOSCommStream.WaitEvent(Const Events: TComEvents): TComEvents;
Var
    Mask: DWord;
    E: Boolean;
Begin
    Result := [];
    Try
        SetCommMask(FHandle, EventsToInt(Events));
        Mask := 0;
        E    := WaitCommEvent(FHandle, Mask, Nil);
        If not E Then
        Begin
            Result := [];
            //raise EComPort.Create('Wait Failed');
        End;
        Result := IntToEvents(Mask);
    Finally
        SetCommMask(FHandle, 0);
    End;
End;

Function TmnOSCommStream.GetFlowControlFlags: TFlowControlFlags;
Begin
    Result := Inherited GetFlowControlFlags;
    //Result.ControlDTR := dtrEnable;
End;

Function TmnOSCommStream.DoRead(Var Buffer; Count: Integer): Integer;
Var
    Bytes: DWORD;
    E: Cardinal;
Begin
    Bytes := 0;
    Result := 0;
    Try
        If ReadFile(FHandle, Buffer, Count, Bytes, Nil) Then
        Begin
            E := 0;
        End
        Else E := GetLastError;

        If E > 0 Then RaiseLastOSError
        Else Result := Bytes;
    Finally
    End;
End;

Function TmnOSCommStream.DoWrite(Const Buffer; Count: Integer): Integer;
Var
    Bytes: DWORD;
    E: Cardinal;
Begin
    Bytes := 0;
    Result := 0;
    Try
        If WriteFile(FHandle, Buffer, Count, Bytes, Nil) Then
        Begin
            E := 0;
        End
        Else E := GetLastError;

        If E > 0 Then RaiseLastOSError
        Else Result := Bytes;
    Finally
    End;
End;

End.
